Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue58/EasyWeb/Charts.pas

Pascal/Delphi Source File | 2000-03-14 | 36.6 KB | 1,221 lines

{ *****************************************************
                  ThgCustomChart Component

  ThgCustomChart is a custom base class for TXYChart and
  other XY, scatter, line and bar charts.

                    Paul Warren
           HomeGrown Software Development
         (c) 1997 Langley British Columbia.
                  [phone]
           e-mail:  [e-mail]
     Home page: http://users.uniserve.com/~hg_soft
  ***************************************************** }

unit Charts;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Math;

type
  TTitleStr = string[35];
  TGridType = (gtNone, gtHorz, gtVert, gtBoth);

  ThgCustomChart = class(TGraphicControl)
  private
    { private declarations }
    FTitle: TTitleStr;
    FTitleFont: TFont;
    FXLabel: TTitleStr;
    FYLabel: TTitleStr;
    FXYLabelFont: TFont;
    FGrid: TGridType;
    FBackGround: TColor;
    FChartColor: TColor;
    FBorderWidth: integer;
    FMinX: Double;
    FMinY: Double;
    FMaxX: Double;
    FMaxY: Double;
    OffScreen: TBitMap;
    function GetChartRect: TRect; virtual;
    function GetDrawRect: TRect; virtual; abstract;
    procedure SetTitle(Value: TTitleStr);
    procedure SetTitleFont(Value: TFont);
    procedure SetXLabel(Value: TTitleStr);
    procedure SetYLabel(Value: TTitleStr);
    procedure SetXYLabelFont(Value: TFont);
    procedure SetGrid(Value: TGridType);
    procedure SetBackGround(Value: TColor);
    procedure SetChartColor(Value: TColor);
    procedure SetBorderWidth(Value: integer);
  protected
    { protected declarations }
    procedure Paint; override;
    procedure DrawGrid(Rect: TRect); virtual; abstract;
    procedure DrawXScale; virtual; abstract;
    procedure DrawYScale; virtual; abstract;
    procedure DrawDataPoints; virtual; abstract;
    procedure ScaleChart; virtual; abstract;
    property ChartRect: TRect read GetChartRect;
    property DrawRect: TRect read GetDrawRect;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PaintTo(DC: HDC; X, Y: Integer);
    function GetComponentImage: TBitmap;
    property Title: TTitleStr read FTitle write SetTitle;
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property XLabel: TTitleStr read FXLabel write SetXLabel;
    property YLabel: TTitleStr read FYLabel write SetYLabel;
    property XYLabelFont: TFont read FXYLabelFont write SetXYLabelFont;
    property Grid: TGridType read FGrid write SetGrid default gtNone;
    property BackGround: TColor read FBackGround write SetBackGround default clSilver;
    property ChartColor: TColor read FChartColor write SetChartColor default clWhite;
    property BorderWidth: integer read FBorderWidth write SetBorderWidth default 1;
    property MinX: Double read FMinX write FMinX;
    property MaxX: Double read FMaxX write FMaxX;
    property MinY: Double read FMinY write FMinY;
    property MaxY: Double read FMaxY write FMaxY;
  published
    { published declarations }
  end;

  TDataPoint = class(TObject)
    X, Y: Double;
    ALabel: string[15];
  end;

  TChartDataList = class(TStringList)
  private
    { private declarations }
  public
    { public declarations }
    destructor Destroy; override;
    function AddDataPoint(Point: TDataPoint): integer;
    function GetDataPoint(index: integer): TDataPoint;
  end;

  TDrawPie = procedure(Sender: TObject; var Color: TColor) of object;
  TDrawLabel = procedure(Sender: TObject; Data, DataSum: Double; var DataText: string) of object;

  TPieChart = class(ThgCustomChart)
  private
    { private declarations }
    FDataList: TChartDataList;
    FDataSum: Double;
    FUseLabels: boolean;
    FOnDrawPie: TDrawPie;
    FOnDrawLabel: TDrawLabel;
    function GetDrawRect: TRect; override;
    function GetLegendRect(var Offs: integer): TRect;
  protected
    { protected declarations }
    procedure DrawGrid(Rect: TRect); override;
    procedure DrawXScale; override;
    procedure DrawYScale; override;
    procedure DrawDataPoints; override;
    procedure ScaleChart; override;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddData(X: Double; Y: string);
    procedure ClearData;
  published
    { published declarations }
    property UseLabels: boolean read FUseLabels write FUseLabels default true;
    property OnDrawPie: TDrawPie read FOnDrawPie write FOnDrawPie;
    property OnDrawLabel: TDrawLabel read FOnDrawLabel write FOnDrawLabel;
    property Align;
    property BackGround;
    property BorderWidth;
    property ChartColor;
    property Font;
    property Title;
    property TitleFont;
    property XLabel;
    property XYLabelFont;
  end;

  TChartType = (ctScatter, ctLine, ctBar, ctXY);
  TAxisType = (atXAxis, atYAxis);
  TNeedLines = procedure(Sender: TObject; var Value: Double;
    var AColor: TColor; var Finished: boolean) of object;
  TScaling = procedure(Sender: TObject; var MinX, MaxX, MinY, MaxY: Double) of object;
  TDrawScales = procedure(Sender: TObject; Axis: TAxisType; Data: Double; var DataText: string) of object;

  TXYChart = class(ThgCustomChart)
  private
    { private declarations }
    FChartType: TChartType;
    FDataList: TChartDataList;
    FOnNeedLinesX: TNeedLines;
    FOnNeedLinesY: TNeedLines;
    FOnScaling: TScaling;
    FOnDrawScales: TDrawScales;
    function GetChartRect: TRect; override;
    function GetDrawRect: TRect; override;
    function GetBarWidth: integer;
    function GetDivisionsX(Wid: integer): integer;
    function GetDivisionsY(Ht: integer): integer;
    procedure SetChartType(Value: TChartType);
    procedure SetData(Value: TChartDataList);
  protected
    { protected declarations }
    procedure ScaleChart; override;
    function NormalizePtX(APoint: Double): Double;
    function NormalizePtY(APoint: Double): Double;
    procedure DrawGrid(Rect: TRect); override;
    procedure DrawXScale; override;
    procedure DrawYScale; override;
    procedure DrawDataPoints; override;
    property BarWidth: integer read GetBarWidth;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddData(X, Y: Double);
    procedure Plot;
    procedure ClearData;
    property Data: TChartDataList read FDataList write SetData;
  published
    { published declarations }
    property ChartType: TChartType read FChartType write SetChartType;
    property OnNeedLinesX: TNeedLines read FOnNeedLinesX write FOnNeedLinesX;
    property OnNeedLinesY: TNeedLines read FOnNeedLinesY write FOnNeedLinesY;
    property OnScaling: TScaling read FOnScaling write FOnScaling;
    property OnDrawScales: TDrawScales read FOnDrawScales write FOnDrawScales;
    property Align;
    property BackGround;
    property BorderWidth;
    property ChartColor;
    property Font;
    property Grid;
    property Title;
    property TitleFont;
    property XLabel;
    property YLabel;
    property XYLabelFont;
  end;

procedure Register;

implementation

{$IFDEF WIN32}
  {$R CHARTS.D32}
{$ELSE}
  {$R CHARTS.D16}
{$ENDIF}

{ ThgCustomChart }
constructor ThgCustomChart.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  Width := 147;
  Height := 105;
  FTitle := 'HomeGrown Charts';
  FTitleFont := TFont.Create;
  FTitleFont.Name := 'arial';
  FTitleFont.Style := [fsbold];
  FTitleFont.Size := 11;
  FTitleFont.Color := clRed;
  FXLabel := 'X-Axis';
  FYLabel := 'Y-Axis';
  FXYLabelFont := TFont.Create;
  FXYLabelFont.Name := 'arial';
  FXYLabelFont.Size := 8;
  FGrid := gtNone;
  FBackGround := clSilver;
  FChartColor := clWhite;
  FBorderWidth := 1;
  FMinX := 0;
  FMaxX := 50;
  FMinY := 0;
  FMaxY := 50;
  OffScreen := TBitMap.Create;
end;

destructor ThgCustomChart.Destroy;
begin
   FTitleFont.Free;
   FXYLabelFont.Free;
   OffScreen.Free;
   inherited Destroy;
end;

{ property access routines }
procedure ThgCustomChart.SetTitle(Value: TTitleStr);
begin
  FTitle := Value;
  Refresh;
end;

procedure ThgCustomChart.SetTitleFont(Value: TFont);
begin
  FTitleFont.Assign(Value);
  Refresh;
end;

procedure ThgCustomChart.SetXLabel(Value: TTitleStr);
begin
  FXLabel := Value;
  Refresh;
end;

procedure ThgCustomChart.SetYLabel(Value: TTitleStr);
begin
  FYLabel := Value;
  Refresh;
end;

procedure ThgCustomChart.SetXYLabelFont(Value: TFont);
begin
  FXYLabelFont.Assign(Value);
  Refresh;
end;

procedure ThgCustomChart.SetGrid(Value: TGridType);
begin
  if Value <> FGrid then
  begin
    FGrid := Value;
    Refresh;
  end;
end;

procedure ThgCustomChart.SetBackGround(Value: TColor);
begin
  if Value <> FBackGround then
  begin
    FBackGround := Value;
    Refresh;
  end;
end;

procedure ThgCustomChart.SetChartColor(Value: TColor);
begin
  if Value <> FChartColor then
  begin
    FChartColor := Value;
    Refresh;
  end;
end;

procedure ThgCustomChart.SetBorderWidth(Value: integer);
begin
  if Value <> FBorderWidth then
  begin
    FBorderWidth := Value;
    if FBorderWidth < 1 then FBorderWidth := 1;
    if FBorderWidth > 4 then FBorderWidth := 4;
    Refresh;
  end;
end;

{ GetChartRect method }
function ThgCustomChart.GetChartRect: TRect;
begin
  with OffScreen do
  begin
    { calulate the TRect for the whole chart }
    Canvas.Font := TitleFont;
    Result.Top := Round(Canvas.TextHeight(FTitle) * 1.5);
    Canvas.Font := XYLabelFont;
    Result.Left := Round(Canvas.TextHeight('Aj') * 1.5);
    Result.Right := Width - Round(Canvas.TextHeight('Aj') * 1.5);
    Result.Bottom := Height - Round(Canvas.TextHeight('Aj') * 1.5);
    Canvas.Font := Font;
  end;
end;

{ Paint method }
procedure ThgCustomChart.Paint;
var
  hFontNew: HFONT;
  hFontOld: HFONT;
  p: string;
begin
  { paint handles all the drawing unrelated to the actual plot
    ie. title, color, border etc. }
  OffScreen.Width := ClientWidth;
  OffScreen.Height := ClientHeight;
  Font := Font;
  with OffScreen.Canvas do
  begin
    { draw background }
    Brush.Style := bsSolid;
    Brush.Color := FBackGround;
    FillRect(ClientRect);

    { draw title }
    Font := TitleFont;
    TextOut((Width-TextWidth(FTitle)) div 2, 1, FTitle);

    { draw x-axis label }
    Font := XYLabelFont;
    TextOut((Width-TextWidth(FXLabel)) div 2, Height-TextHeight(FXLabel), FXLabel);

    { draw y-axis  label }
    p := Font.Name + #0; { PChar }
    { Creation of the object font and angle }
    hFontNew:= CreateFont(
      { Height      } Font.Height,
      { Width       } 0,
      { Escapement  } 900, { angle of slant of text }
      { Orientation } 0, { expressed in tenth of degree  }
      { Weight      } ord(fsBold in Font.Style) * FW_BOLD,
      { Italic      } ord(fsItalic     in Font.Style),
      { Underline   } ord(fsUnderLine  in Font.Style),
      { StrikeOut   } ord(fsStrikeOut  in Font.Style),
      { Charset     } DEFAULT_CHARSET,
      { OutputPrec. } OUT_DEFAULT_PRECIS,
      { ClipPrec.   } CLIP_DEFAULT_PRECIS,
      { Quality     } DEFAULT_QUALITY,
      { Pitch       } DEFAULT_PITCH + FF_DONTCARE,
      { FaceName    } @p[1]
    );
    { store old font and select new }
    hFontOld := SelectObject(Handle, hFontNew);
    { output text in new font }
    TextOut(1, (Height+TextHeight(FYLabel)) div 2, FYLabel);
    { return the old font }
    SelectObject(Handle, hFontOld);
    { delete the new font }
    DeleteObject(hFontNew);

    { scale the chart - abstract }
    ScaleChart;

    { draw border }
    Brush.Style := bsSolid;
    Brush.Color := FChartColor;
    Pen.Width := FBorderWidth;
    RoundRect(ChartRect.Left, ChartRect.Top, ChartRect.Right,
      ChartRect.Bottom, 15, 15);
    Pen.Width := 1;
    Font.Color := clBlack;

    { draw Grid }
    DrawGrid(ChartRect);

    { draw axis scales - abstract }
    DrawXScale;
    DrawYScale;

    { draw data points - abstract }
    DrawDataPoints;
  end;
  Canvas.Draw(0, 0, OffScreen);
end;

{ PaintTo method }
procedure ThgCustomChart.PaintTo(DC: HDC; X, Y: Integer);
var
  SaveIndex: Integer;
begin
  SaveIndex := SaveDC(DC);
  MoveWindowOrg(DC, X, Y);
  IntersectClipRect(DC, 0, 0, Width, Height);
  Perform(WM_ERASEBKGND, DC, 0);
  Perform(WM_PAINT, DC, 0);
  RestoreDC(DC, SaveIndex);
end;

{ GetComponentImage method }
function ThgCustomChart.GetComponentImage: TBitmap;
begin
  Result := TBitmap.Create;
  try
    Result.Width := ClientWidth;
    Result.Height := ClientHeight;
    Result.Canvas.Lock;
    try
      PaintTo(Result.Canvas.Handle, 0, 0);
    finally
      Result.Canvas.Unlock;
    end;
  except
    Result.Free;
    raise;
  end;
end;

{ TPieChart }
constructor TPieChart.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // create the data list
  FDataList := TChartDataList.Create;
  // set default values
  Width := 200;
  Height := 150;
  FDataSum := 0;
  FYLabel := '';
  FUseLabels := true;
end;

destructor TPieChart.Destroy;
begin
  // free the data list
  FDataList.Free;
  inherited Destroy;
end;

function TPieChart.GetLegendRect(var Offs: integer): TRect;
begin
  // get chart rect
  Result := GetChartRect;

  // size it
  Result.Left := Result.Right-Offscreen.Canvas.TextWidth('Abcdefghijklmno')-19;
  Result.Top := Result.Top;
  Result.Bottom := Result.Bottom;

  // calc space for legends
  if FDataList.Count <> 0 then
    Offs := (Result.Bottom-Result.Top) div FDataList.Count
  else
    Offs := (Result.Bottom-Result.Top);
end;

{ GetDrawRect - get area for drawing }
function TPieChart.GetDrawRect: TRect;
var
  Offs: integer;
  CR, LR: TRect;
  dx, dy: integer;
begin
  // get chart rect
  CR := GetChartRect;
  // get legend rect
  LR := GetLegendRect(Offs);

  // calculate difference
  SubtractRect(Result, CR, LR);
  // offset for appearance
  Offs := ((5 * Height) div 100);

  // calculate drawing rect for pie
  if Result.Right >= Result.Bottom then  // if wider than high
  begin
    Result.Top := Result.Top+Offs;
    Result.Bottom := Result.Bottom-Offs;
    Result.Left := Result.Left+Offs;
    Result.Right := Result.Left+(Result.Bottom - Result.Top);
    dx := ((LR.Left-CR.Left) div 2)-(((Result.Right-Result.Left)+Offs) div 2);
    OffsetRect(Result, dx, 0);
  end else // else higher than wide
  begin
    Result.Top := Result.Top + Offs;
    Result.Left := Result.Left+Offs;
    Result.Right := Result.Right-Offs;
    Result.Bottom := Result.Top+(Result.Right-Result.Left);
    dy := (CR.Bottom div 2)-((Result.Bottom+Offs) div 2);
    OffsetRect(Result, 0, dy);
  end;
end;

procedure TPieChart.AddData(X: Double; Y: string);
var
  P: TDataPoint;
begin
  // keep track of data sum
  FDataSum := FDataSum+X;

  // create data object
  P := TDataPoint.Create;
  P.X := X; P.Y := 0;
  P.ALabel := Y;

  // add it to the list
  FDataList.AddDataPoint(P);
  // don't need to free - the list does that
end;

procedure TPieChart.ClearData;
begin
  if FDataList.Count <> 0 then FDataList.Clear; // clear data
  FDataSum := 0; // re-set datasum
end;

procedure TPieChart.DrawGrid(Rect: TRect);
begin
  // no grids
end;

procedure TPieChart.DrawXScale;
begin
  // do nothing - no scales
end;

procedure TPieChart.DrawYScale;
begin
  // do nothing - no scales
end;

procedure TPieChart.ScaleChart;
begin
  // do nothing - no extrema
end;

procedure TPieChart.DrawDataPoints;
const
  Margin: integer = 5;
  AColor: array[0..16] of TColor = (clAqua, clBlue, clFuchsia, clRed, clLime,
    clYellow, clLtGray, clNavy, clMaroon, clGray, clOlive, clPurple, clSilver,
    clTeal, clDkGray, clWhite, clGreen);
var
  LegendRect: TRect;
  midX, midY: integer;
  SAngle, EAngle: integer;
  i: integer;
  LegendOffs: integer;
  Color: TColor;
  DataText: string;

  // get point from angle and length
  function GetPoint(Angle, Length: integer): TPoint;
  var
    sX, sY: double;
  begin
    sX := Cos((Angle / 180.0) * pi);
    sY := Sin((Angle / 180.0) * pi);  // in radians
    Result.X := Round(sX * Length);
    Result.Y := Round(sY * Length);
  end;

  // get angle form data/datasum
  function GetAngle(Value: Double): integer;
  var
    Tmp: Double;
  begin
    Tmp := (Value/FDataSum) * 360;
    Result := Round(Tmp);
  end;

  // calculate radius in pixels
  function Radius: integer;
  begin
    Result := (DrawRect.Bottom-DrawRect.Top) div 2;
  end;

  // draw data labels in pie slice only if they fit in the slice
  procedure DrawValues(SAngle, EAngle: integer; P: TPoint; S: string);
  var
    Points: array[0..2] of TPoint;
    Rgn, TmpRgn: hRgn;
    SA, EA: integer;
  begin
    TmpRgn := 0;
    with Offscreen.Canvas do
    begin
      // offset text starting point so
      // center of text at center of pie
      P.X := P.X - (TextWidth(S) div 2);
      P.Y := P.Y - (TextHeight(S) div 2);

      // compute region similar to pie
      SA := SAngle;
      EA := SA + 20;
      if EA > EAngle then EA := EAngle;
      Points[0] := Point(MidX, MidY);
      Points[1] := Point(MidX+GetPoint(SA, Radius).X, MidY-GetPoint(SA, Radius).Y);
      Points[2] := Point(midX+GetPoint(EA, Radius).X, midY-GetPoint(EA, Radius).Y);
      Rgn := CreatePolygonRgn(Points, 3, ALTERNATE); // first slice
      try
        SA := EA;
        while SA <> EAngle do
        begin
          EA := SA + 20;
          if EA > EAngle then EA := EAngle;
          Points[0] := Point(MidX, MidY);
          Points[1] := Points[2];
          Points[2] := Point(midX+GetPoint(EA, Radius).X, midY-GetPoint(EA, Radius).Y);
          try
            TmpRgn := CreatePolygonRgn(Points, 3, ALTERNATE); // next slice
            CombineRgn(Rgn, Rgn, TmpRgn, RGN_OR); // combine slices
          finally
            DeleteObject(TmpRgn); // free resources
          end;
          SA := EA;
        end;

        // Only output values if the text fits the region
        if PtInRegion(Rgn, P.X, P.Y) and PtInRegion(Rgn, P.X+TextWidth(S), P.Y) and
          PtInRegion(Rgn, P.X, P.Y+TextHeight(S)) and
            PtInRegion(Rgn, P.X+TextWidth(S), P.Y+TextHeight(S)) then
          TextOut(P.X, P.Y, S);
      finally
        DeleteObject(Rgn); // free resources
      end;
    end;
  end;

begin
  // get rect for drawing legend
  LegendRect := GetLegendRect(LegendOffs);

  // draw offscreen for speed
  with OffScreen.Canvas do
  begin
    // calculate center
    midX := ((DrawRect.Right+DrawRect.Left) div 2);
    midY := ((DrawRect.Bottom+DrawRect.Top) div 2);

    SAngle := 0; // default value

    // draw and fill circle
    Brush.Color := AColor[0];
    Ellipse(DrawRect);

    // if we have data then start plotting
    if FDataList.Count <> 0 then
      for i := 0 to FDataList.Count-1 do
      begin
        // calculate end angle from start angle and data
        EAngle := SAngle+GetAngle(FDataList.GetDataPoint(i).X);

        Color := AColor[i]; // set color for slice
        if Assigned(FOnDrawPie) then FOnDrawPie(Self, Color); // trigger event
        Brush.Color := Color; // re-set color in case modified

        if EAngle <> SAngle then // don't bother drawing pie if angles are equal
          Pie(DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom,
            MidX+GetPoint(SAngle, Radius).X, MidY-GetPoint(SAngle, Radius).Y,
              midX+GetPoint(EAngle, Radius).X, midY-GetPoint(EAngle, Radius).Y);

        // draw data labels
        DataText := FloatToStr(FDataList.GetDataPoint(i).X);
        if Assigned(FOnDrawLabel) then FOnDrawLabel(Self, FDataList.GetDataPoint(i).X, FDataSum, DataText);
        if FUseLabels then
          DrawValues(SAngle, EAngle, Point(MidX+GetPoint((EAngle+SAngle) div 2, Radius div 2).X,
            MidY-GetPoint((EAngle+SAngle) div 2, Radius div 2).Y), DataText);

        // draw legend
        Rectangle(LegendRect.Left+Margin, LegendRect.Top+((i+1)*LegendOffs)-(LegendOffs div 2),
          LegendRect.Left+Margin+14, LegendRect.Top+((i+1)*LegendOffs-(LegendOffs div 2)+14));
        Brush.Color := ChartColor;
        TextRect(Rect(LegendRect.Left+Margin+20, LegendRect.Top+((i+1)*LegendOffs-(LegendOffs div 2)),
          LegendRect.Right-5, LegendRect.Bottom-1), LegendRect.Left+Margin+20,
            LegendRect.Top+((i+1)*LegendOffs)-(LegendOffs div 2), FDataList.GetDataPoint(i).ALabel);

        // set end angle equal to start angle for next iteration
        SAngle := EAngle;
      end;
  end;
end;

{ TChartDataList - data structure for the chart data }
destructor TChartDataList.Destroy;
var
  Temp: TObject;
begin
  while Count <> 0 do
  begin
    { make Temp := first Item }
    Temp := Objects[0];
    { free it }
    Temp.Free;
    { delete it }
    Delete(0);
  end;
  { call inherited }
  inherited Destroy;
end;

function TChartDataList.AddDataPoint(Point: TDataPoint): integer;
begin
  Result := AddObject('', Point);
end;

function TChartDataList.GetDataPoint(index: integer): TDataPoint;
begin
  Result := Objects[index] as TDataPoint;
end;

{ TXYChart }
constructor TXYChart.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { create the data list }
  FDataList := TChartDataList.Create;
end;

destructor TXYChart.Destroy;
begin
  { free the data list }
  FDataList.Free;
  inherited Destroy;
end;

procedure TXYChart.AddData(X, Y: Double);
var
  P: TDataPoint;
begin
  { create data object }
  P := TDataPoint.Create;
  P.X := X; P.Y := Y;
  { add it to the list }
  FDataList.AddDataPoint(P);
  { don't need to free - the list does that }
end;

procedure TXYChart.SetChartType(Value: TChartType);
begin
  if Value <> FChartType then
  begin
    FChartType := Value;
    Refresh;
  end;
end;

procedure TXYChart.ClearData;
begin
  if FDataList.Count <> 0 then FDataList.Clear;
end;

procedure TXYChart.Plot;
begin
  Refresh;
end;

procedure TXYChart.SetData(Value: TChartDataList);
begin
  FDataList.Free;
  FDataList.Assign(Value);
  Refresh;
end;

{ GetChartRect method }
function TXYChart.GetChartRect: TRect;
begin
  Result := inherited GetChartRect;
  Result.Left := Result.Left + OffScreen.Canvas.TextWidth(Format('%6.3f', [FMaxY]));
  Result.Bottom := Result.Bottom - OffScreen.Canvas.TextHeight('Aj');
end;

{ GetDrawRect - get area for drawing }
function TXYChart.GetDrawRect: TRect;
begin
  { get chart rect }
  Result := GetChartRect;
  { offset inwards 3 and 4 percent }
  Result.Left := Result.Left + ((4 * Width) div 100);
  Result.Top := Result.Top + ((3 * Width) div 100);
  Result.Right := Result.Right - ((4 * Width) div 100);
  Result.Bottom := Result.Bottom - ((3 * Width) div 100);
end;

{ GetBarWidth - get width of bars for bar chart }
function TXYChart.GetBarWidth: integer;
const
  MaxBarWidth: integer = 15;
begin
  Result := (((DrawRect.Right-DrawRect.Left) div FDataList.Count) div 2);
  if Result > MaxBarWidth then Result := MaxBarWidth;
end;

{ ScaleChart - calculate extrema }
procedure TXYChart.ScaleChart;

  function XMaxima: Double;
  var
    i: integer;
  begin
    Result := FDataList.GetDataPoint(0).X;
    for i := 0 to FDataList.Count-1 do
      if FDataList.GetDataPoint(i).X > Result then Result := FDataList.GetDataPoint(i).X;
  end;

  function YMaxima: Double;
  var
    i: integer;
  begin
    Result := FDataList.GetDataPoint(0).Y;
    for i := 0 to FDataList.Count-1 do
      if FDataList.GetDataPoint(i).Y > Result then Result := FDataList.GetDataPoint(i).Y;
  end;

  function XMinima: Double;
  var
    i: integer;
  begin
    Result := FDataList.GetDataPoint(0).X;
    for i := 0 to FDataList.Count-1 do
      if FDataList.GetDataPoint(i).X < Result then Result := FDataList.GetDataPoint(i).X;
  end;

  function YMinima: Double;
  var
    i: integer;
  begin
    Result := FDataList.GetDataPoint(0).Y;
    for i := 0 to FDataList.Count-1 do
      if FDataList.GetDataPoint(i).Y < Result then Result := FDataList.GetDataPoint(i).Y;
  end;

  function TruncFloat(Value: Extended): Extended;
  var
    FloatRec: TFloatRec;
    Temp: string;
  begin
    FloatToDecimal(FloatRec, Value, fvExtended, 12, 9999);
    Temp := FloatToStrF(Value, ffExponent, 1, FloatRec.Exponent);
    Result := StrToFloat(Temp);
  end;

begin
  if FDataList.Count <> 0 then
  begin
    // set extreme values - average +/- half the
    // absolute difference between extrema
    FMinX := ((XMaxima+XMinima)/2)-(abs(XMaxima-XMinima)/2);
    FMaxX := ((XMaxima+XMinima)/2)+(abs(XMaxima-XMinima)/2);
    FMinY := ((YMaxima+YMinima)/2)-(abs(YMaxima-YMinima)/2);
    FMaxY := ((YMaxima+YMinima)/2)+(abs(YMaxima-YMinima)/2);
  end;
  if Assigned(FOnScaling) then FOnScaling(Self, FMinX, FMaxX, FMinY, FMaxY);
  // make sure minima and maxima are not equal
  if FMinX-FMaxX = 0 then
  begin
    FMinX := FMinX-0.1;
    FMaxX := FMaxX+0.1;
  end;
  if FMinY-FMaxY = 0 then
  begin
    FMinY := FMinY-0.1;
    FMaxY := FMaxY+0.1;
  end;
end;

function TXYChart.GetDivisionsX(Wid: integer): integer;
begin
  Result := Wid div (2 * OffScreen.Canvas.TextWidth(Format('%6.3f', [FMaxX])));
  if Result >= 5 then Result := 10;
end;

function TXYChart.GetDivisionsY(Ht: integer): integer;
begin
  Result := Ht div (2 * (OffScreen.Canvas.TextHeight('Aj')));
  if Result >= 5 then Result := 10;
end;

{ procedure to draw grids if desired }
procedure TXYChart.DrawGrid(Rect: TRect);
var
  i: integer;
  Xinterval: integer;
  Yinterval: integer;
  GraphWd: integer;
  GraphHt: integer;

  procedure DoDrawGridX(Amount: integer);
  begin
    with OffScreen.Canvas Do
    begin
      MoveTo(DrawRect.Right-Amount, ChartRect.Top+BorderWidth);
      LineTo(DrawRect.Right-Amount, ChartRect.Bottom-BorderWidth);
    end;
  end;

  procedure DoDrawGridY(Amount: integer);
  begin
    with OffScreen.Canvas Do
    begin
      MoveTo(ChartRect.Left+BorderWidth, DrawRect.Top + Amount);
      LineTo(ChartRect.Right-BorderWidth, DrawRect.Top + Amount);
    end;
  end;

begin
  if FGrid = gtNone then Exit;
  GraphWd := (DrawRect.Right - DrawRect.Left);
  GraphHt := (DrawRect.Bottom - DrawRect.Top);
  Xinterval := GetDivisionsX(GraphWd);
  Yinterval := GetDivisionsY(GraphHt);
  with OffScreen.Canvas do
  begin
    if FChartColor <> clSilver then Pen.Color := clSilver
      else Pen.Color := clGray;
    case FGrid of
      gtBoth, gtVert:
        case XInterval of
        0,1,2: begin
            DoDrawGridX(GraphWd);
            DoDrawGridX(GraphWd Div 2);
            DoDrawGridX(0);
          end;
        3: begin
            DoDrawGridX(0);
            DoDrawGridX(GraphWd Div 4);
            DoDrawGridX(GraphWd Div 2);
            DoDrawGridX(GraphWd Div 4*3);
            DoDrawGridX(GraphWd);
          end;
        4: begin
          for I := 0 to 10 do
            if not Odd(I) then
              DoDrawGridX(Round(GraphWd * I/10));
          end;
        else
          for I := 0 To 10 do
            DoDrawGridX(Round(GraphWd * I/10));
        end;
    end;
    case FGrid of
      gtBoth, gtHorz:
        case YInterval of
        0,1,2: begin
            DoDrawGridY(GraphHt);
            DoDrawGridY(GraphHt Div 2);
            DoDrawGridY(0);
          end;
        3: begin
            DoDrawGridY(0);
            DoDrawGridY(GraphHt Div 4);
            DoDrawGridY(GraphHt Div 2);
            DoDrawGridY(GraphHt Div 4*3);
            DoDrawGridY(GraphHt);
          end;
        4: begin
          for I := 0 to 10 do
            if not Odd(I) then
              DoDrawGridY(Round(GraphHt * I/10));
          end;
        else
          for I := 0 To 10 do
            DoDrawGridY(Round(GraphHt * I/10));
        end;
    end;
  end;
end;

procedure TXYChart.DrawXScale;
var
  i: integer;
  interval: integer;
  GraphWid: integer;
  Range: Double;

  procedure DoDrawScale(Offs: integer; Value: Double);
  var
    S: string;
    R: TRect;
    X: integer;
  begin
    with OffScreen.Canvas Do
    begin
      MoveTo(DrawRect.Right-Offs, ChartRect.Bottom-BorderWidth-5);
      LineTo(DrawRect.Right-Offs, ChartRect.Bottom-BorderWidth);
      S := FloatToStr(Value);
      if Assigned(FOnDrawScales) then FOnDrawScales(Self, atXAxis, Value, S);
      R := Rect(DrawRect.Right-Offs-(((DrawRect.Right-DrawRect.Left) div interval) div 2),
        ChartRect.Bottom+3, DrawRect.Right-Offs+(((DrawRect.Right-DrawRect.Left) div interval) div 2),
          ChartRect.Bottom+TextHeight(S)+3);
      X := DrawRect.Right-Offs-(TextWidth(S) div 2);
      if X < DrawRect.Right-Offs-(((DrawRect.Right-DrawRect.Left) div interval) div 2)
        then X := DrawRect.Right-Offs-(((DrawRect.Right-DrawRect.Left) div interval) div 2);
      TextRect(R, X, ChartRect.Bottom+3, S);
    end;
  end;

begin
  GraphWid := (DrawRect.Right - DrawRect.Left);
  Range := FMaxX-FMinX;
  interval := GetDivisionsX(GraphWid);
  with OffScreen.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := FBackGround;
    case interval of
     0: begin
          MoveTo(DrawRect.Left+(GraphWid div 2), ChartRect.Bottom-BorderWidth-5);
          LineTo(DrawRect.Left+(GraphWid div 2), ChartRect.Bottom-BorderWidth);
        end;
     1: DoDrawScale(GraphWid Div 2, Range / 2 + FMinX);
     2: begin
          DoDrawScale(GraphWid, FMinX);
          DoDrawScale(GraphWid Div 2, Range / 2+FMinX);
          DoDrawScale(0, FMaxX);
        end;
     3: begin
          DoDrawScale(0, FMaxX);
          DoDrawScale(GraphWid Div 4, Range / 4*3+FMinX);
          DoDrawScale(GraphWid Div 2, Range / 2+FMinX);
          DoDrawScale(GraphWid Div 4*3, Range / 4+FMinX);
          DoDrawScale(GraphWid, FMinX);
        end;
     4: begin
          for I := 0 to 10 do
            if not Odd(I) then
              DoDrawScale(Round(GraphWid * I/10), Range*(10-I)/10+FMinX);
        end;
     else
        for I := 0 To 10 do
          DoDrawScale(Round(GraphWid* I/10), Range*(10-I)/10+FMinX);
    end; {Case}
  end;
end;

procedure TXYChart.DrawYScale;
var
  i: integer;
  interval: LongInt;
  GraphHt: integer;
  Range: Double;

  procedure DoDrawScale(Offs: integer; Value: Double);
  var
    S: string;
  begin
    with OffScreen.Canvas Do
    begin
      MoveTo(ChartRect.Left, DrawRect.Top+Offs);
      LineTo(ChartRect.Left+5, DrawRect.Top+Offs);
      S := FloatToStr(Value);
      if Assigned(FOnDrawScales) then FOnDrawScales(Self, atYAxis, Value, S);
      TextOut(ChartRect.Left-3-TextWidth(S), DrawRect.Top+Offs-(TextHeight(S) div 2), S);
    end;
  end;

begin
  GraphHt := (DrawRect.Bottom - DrawRect.Top);
  Range := FMaxY-FMinY;
  interval := GetDivisionsY(GraphHt);
  with OffScreen.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := FBackGround;
    case interval of
     0: begin
          MoveTo(ChartRect.Left, DrawRect.Top + (GraphHt div 2));
          LineTo(ChartRect.Left+5, DrawRect.Top + (GraphHt div 2));
        end;
     1: DoDrawScale(GraphHt div 2,Range / 2+FMinY);
     2: begin
          DoDrawScale(GraphHt, FMinY);
          DoDrawScale(GraphHt div 2, Range / 2+FMinY);
          DoDrawScale(0, FMaxY);
        end;
     3: begin
          DoDrawScale(GraphHt, FMinY);
          DoDrawScale(GraphHt div 4,Range / 4*3+FMinY);
          DoDrawScale(GraphHt div 2,Range / 2+FMinY);
          DoDrawScale(GraphHt div 4*3,Range / 4+FMinY);
          DoDrawScale(0, FMaxY);
        end;
     4: begin
          for I := 0 to 10 do
            if not Odd(I) then
              DoDrawScale(Round(GraphHt * I/10), Range*(10-I)/10+FMinY);
        end;
     else
        for I := 0 To 10 do
          DoDrawScale(Round(GraphHt* I/10), Range*(10-I)/10+FMinY);
    end; {Case}
  end;
end;

{ NormalizePtX - transform  X-axis data to chart dimensions }
function TXYChart.NormalizePtX(APoint: Double): Double;
var
  W: integer;
begin
  Result := APoint;
  W := DrawRect.Right-DrawRect.Left;
  { if axis range <> 0 - otherwise div by zero }
  if FMaxX-FMinX <> 0 then
    { make data point a relative fraction of
      the chart draw rect }
    Result := (APoint-FMinX)*W/(FMaxX-FMinX);
end;

{ NormalizePtY - transform  Y-axis data to chart dimensions }
function TXYChart.NormalizePtY(APoint: Double): Double;
var
  H: integer;
begin
  Result := APoint;
  H := DrawRect.Bottom-DrawRect.Top;
  { if axis range <> 0 - otherwise div by zero }
  if FMaxX-FMinX <> 0 then
    { make data point a relative fraction of
      the chart draw rect }
    Result := (APoint-FMinY)*H/(FMaxY-FMinY);
end;

procedure TXYChart.DrawDataPoints;
var
  i: integer;
  X, Y: Double;
  Finished: boolean;
  AColor: TColor;
  Rgn: hRgn;
begin
  with OffScreen.Canvas do
  begin
    Pen.Color := clBlack;
    if FDataList.Count <> 0 then
    begin
      { move pen to 1st data point }
      MoveTo(DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(0).X)),
        DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(0).Y)));
      { iterate through data }
      for i := 0 to FDataList.Count-1 do
      begin
        Rgn := CreateRectRgn(DrawRect.Left-5, DrawRect.Top-5, DrawRect.Right+5, DrawRect.Bottom+5);
        SelectClipRgn(OffScreen.Canvas.Handle, Rgn);
        case FChartType of
          ctLine: LineTo(DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)),
            DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)));
          ctBar: begin
            Brush.Style := bsSolid;
            Brush.Color := clNavy;
            Rectangle(DrawRect.Left+Ceil(NormalizePtX(FDataList.GetDataPoint(i).X))-BarWidth,
              DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)),
                DrawRect.Left+Floor(NormalizePtX(FDataList.GetDataPoint(i).X))+BarWidth,
                  DrawRect.Bottom);
          end;
          ctScatter: Ellipse(DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)-3),
            DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)-3),
              DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)+3),
                DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)+3));
          ctXY: begin
            LineTo(DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)),
              DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)));
            Ellipse(DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)-3),
              DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)-3),
                DrawRect.Left+Round(NormalizePtX(FDataList.GetDataPoint(i).X)+3),
                  DrawRect.Bottom-Round(NormalizePtY(FDataList.GetDataPoint(i).Y)+3));
          end;
        end;
        DeleteObject(Rgn);
      end;
      { Set finished to true }
      Finished := true;
      { set tag - counter - to 0 }
      Self.Tag := 0;
      { set X and Y to values below Minima }
      X := FMinX-10;
      Y := FMinY-10;
      repeat
        if Assigned(FOnNeedLinesX) then
        begin
          { trigger event }
          FOnNeedLinesX(Self, X, AColor, Finished);
          X := NormalizePtX(X);
          if (DrawRect.Left+Round(X) < DrawRect.Right) and
            (DrawRect.Left+Round(X) > DrawRect.Left) then with OffScreen.Canvas do
          begin
            Pen.Color := AColor;
            { draw line }
            MoveTo(DrawRect.Left+Round(X), DrawRect.Top);
            LineTo(DrawRect.Left+Round(X), DrawRect.Bottom);
          end;
          { increment tag - counter }
          Self.Tag := Self.Tag + 1;
        end;
      until Finished = true;
      { reset counter - finished is already true }
      Self.Tag := 0;
      repeat
        if Assigned(FOnNeedLinesY) then
        begin
          FOnNeedLinesY(Self, Y, AColor, Finished);
          Y := NormalizePtY(Y);
          if (DrawRect.Bottom-Round(Y) > DrawRect.Top) and
            (DrawRect.Bottom-Round(Y) < DrawRect.Bottom) then with OffScreen.Canvas do
          begin
            Pen.Color := AColor;
            { draw line }
            MoveTo(DrawRect.Left, DrawRect.Bottom-Round(Y));
            LineTo(DrawRect.Right, DrawRect.Bottom-Round(Y));
          end;
          { increment tag - counter }
          Self.Tag := Self.Tag + 1;
        end;
      until Finished = true;
      { reset pen color }
      Pen.Color := clBlack;
    end;
  end;
end;

{ register component on HomeGrown page }
procedure Register;
begin
  RegisterComponents('HomeGrown', [TPieChart]);
  RegisterComponents('HomeGrown', [TXYChart]);
end;

end.